home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / lib / tcl / dist6.3 / tests / proc.test < prev    next >
Encoding:
Text File  |  1991-11-01  |  8.9 KB  |  334 lines
  1. # Commands covered:  proc, return, global
  2. #
  3. # This file contains a collection of tests for one or more of the Tcl
  4. # built-in commands.  Sourcing this file into Tcl runs the tests and
  5. # generates output for errors.  No output means no errors were found.
  6. #
  7. # Copyright 1991 Regents of the University of California
  8. # Permission to use, copy, modify, and distribute this
  9. # software and its documentation for any purpose and without
  10. # fee is hereby granted, provided that this copyright notice
  11. # appears in all copies.  The University of California makes no
  12. # representations about the suitability of this software for any
  13. # purpose.  It is provided "as is" without express or implied
  14. # warranty.
  15. #
  16. # $Header: /user6/ouster/tcl/tests/RCS/proc.test,v 1.9 91/10/31 16:40:55 ouster Exp $ (Berkeley)
  17.  
  18. if {[string compare test [info procs test]] == 1} then {source defs}
  19.  
  20. proc tproc {} {return a; return b}
  21. test proc-1.1 {simple procedure call and return} {tproc} a
  22. proc tproc x {
  23.     set x [expr $x+1]
  24.     return $x
  25. }
  26. test proc-1.2 {simple procedure call and return} {tproc 2} 3
  27. test proc-1.3 {simple procedure call and return} {
  28.     proc tproc {} {return foo}
  29. } {}
  30. test proc-1.4 {simple procedure call and return} {
  31.     proc tproc {} {return}
  32.     tproc
  33. } {}
  34.  
  35. test proc-2.1 {local and global variables} {
  36.     proc tproc x {
  37.     set x [expr $x+1]
  38.     return $x
  39.     }
  40.     set x 42
  41.     list [tproc 6] $x
  42. } {7 42}
  43. test proc-2.2 {local and global variables} {
  44.     proc tproc x {
  45.     set y [expr $x+1]
  46.     return $y
  47.     }
  48.     set y 18
  49.     list [tproc 6] $y
  50. } {7 18}
  51. test proc-2.3 {local and global variables} {
  52.     proc tproc x {
  53.     global y
  54.     set y [expr $x+1]
  55.     return $y
  56.     }
  57.     set y 189
  58.     list [tproc 6] $y
  59. } {7 7}
  60. test proc-2.4 {local and global variables} {
  61.     proc tproc x {
  62.     global y
  63.     return [expr $x+$y]
  64.     }
  65.     set y 189
  66.     list [tproc 6] $y
  67. } {195 189}
  68. catch {unset _undefined_}
  69. test proc-2.5 {local and global variables} {
  70.     proc tproc x {
  71.     global _undefined_
  72.     return $_undefined_
  73.     }
  74.     list [catch {tproc xxx} msg] $msg
  75. } {1 {can't read "_undefined_": no such variable}}
  76. test proc-2.6 {local and global variables} {
  77.     set a 114
  78.     set b 115
  79.     global a b
  80.     list $a $b
  81. } {114 115}
  82.  
  83. proc do {cmd} {eval $cmd}
  84. test proc-3.1 {local and global arrays} {
  85.     catch {unset a}
  86.     set a(0) 22
  87.     list [catch {do {global a; set a(0)}} msg] $msg
  88. } {0 22}
  89. test proc-3.2 {local and global arrays} {
  90.     catch {unset a}
  91.     set a(x) 22
  92.     list [catch {do {global a; set a(x) newValue}} msg] $msg $a(x)
  93. } {0 newValue newValue}
  94. test proc-3.3 {local and global arrays} {
  95.     catch {unset a}
  96.     set a(x) 22
  97.     set a(y) 33
  98.     list [catch {do {global a; unset a(y)}; array names a} msg] $msg
  99. } {0 x}
  100. test proc-3.4 {local and global arrays} {
  101.     catch {unset a}
  102.     set a(x) 22
  103.     set a(y) 33
  104.     list [catch {do {global a; unset a; info exists a}} msg] $msg \
  105.         [info exists a]
  106. } {0 0 0}
  107. test proc-3.5 {local and global arrays} {
  108.     catch {unset a}
  109.     set a(x) 22
  110.     set a(y) 33
  111.     list [catch {do {global a; unset a(y); array names a}} msg] $msg
  112. } {0 x}
  113. catch {unset a}
  114. test proc-3.6 {local and global arrays} {
  115.     catch {unset a}
  116.     set a(x) 22
  117.     set a(y) 33
  118.     do {global a; do {global a; unset a}; set a(z) 22}
  119.     list [catch {array names a} msg] $msg
  120. } {0 z}
  121. test proc-3.7 {local and global arrays} {
  122.     proc t1 {args} {global info; set info 1}
  123.     catch {unset a}
  124.     set info {}
  125.     do {global a; trace var a(1) w t1}
  126.     set a(1) 44
  127.     set info
  128. } 1
  129. test proc-3.8 {local and global arrays} {
  130.     proc t1 {args} {global info; set info 1}
  131.     catch {unset a}
  132.     trace var a(1) w t1
  133.     set info {}
  134.     do {global a; trace vdelete a(1) w t1}
  135.     set a(1) 44
  136.     set info
  137. } {}
  138. test proc-3.9 {local and global arrays} {
  139.     proc t1 {args} {global info; set info 1}
  140.     catch {unset a}
  141.     trace var a(1) w t1
  142.     do {global a; trace vinfo a(1)}
  143. } {{w t1}}
  144. catch {unset a}
  145.  
  146. test proc-3.1 {arguments and defaults} {
  147.     proc tproc {x y z} {
  148.     return [list $x $y $z]
  149.     }
  150.     tproc 11 12 13
  151. } {11 12 13}
  152. test proc-3.2 {arguments and defaults} {
  153.     proc tproc {x y z} {
  154.     return [list $x $y $z]
  155.     }
  156.     list [catch {tproc 11 12} msg] $msg
  157. } {1 {no value given for parameter "z" to "tproc"}}
  158. test proc-3.3 {arguments and defaults} {
  159.     proc tproc {x y z} {
  160.     return [list $x $y $z]
  161.     }
  162.     list [catch {tproc 11 12 13 14} msg] $msg
  163. } {1 {called "tproc" with too many arguments}}
  164. test proc-3.4 {arguments and defaults} {
  165.     proc tproc {x {y y-default} {z z-default}} {
  166.     return [list $x $y $z]
  167.     }
  168.     tproc 11 12 13
  169. } {11 12 13}
  170. test proc-3.5 {arguments and defaults} {
  171.     proc tproc {x {y y-default} {z z-default}} {
  172.     return [list $x $y $z]
  173.     }
  174.     tproc 11 12
  175. } {11 12 z-default}
  176. test proc-3.6 {arguments and defaults} {
  177.     proc tproc {x {y y-default} {z z-default}} {
  178.     return [list $x $y $z]
  179.     }
  180.     tproc 11
  181. } {11 y-default z-default}
  182. test proc-3.7 {arguments and defaults} {
  183.     proc tproc {x {y y-default} {z z-default}} {
  184.     return [list $x $y $z]
  185.     }
  186.     list [catch {tproc} msg] $msg
  187. } {1 {no value given for parameter "x" to "tproc"}}
  188. test proc-3.8 {arguments and defaults} {
  189.     list [catch {
  190.     proc tproc {x {y y-default} z} {
  191.         return [list $x $y $z]
  192.     }
  193.     tproc 2 3
  194.     } msg] $msg
  195. } {1 {no value given for parameter "z" to "tproc"}}
  196. test proc-3.9 {arguments and defaults} {
  197.     proc tproc {x {y y-default} args} {
  198.     return [list $x $y $args]
  199.     }
  200.     tproc 2 3 4 5
  201. } {2 3 {4 5}}
  202. test proc-3.10 {arguments and defaults} {
  203.     proc tproc {x {y y-default} args} {
  204.     return [list $x $y $args]
  205.     }
  206.     tproc 2 3
  207. } {2 3 {}}
  208. test proc-3.11 {arguments and defaults} {
  209.     proc tproc {x {y y-default} args} {
  210.     return [list $x $y $args]
  211.     }
  212.     tproc 2
  213. } {2 y-default {}}
  214. test proc-3.12 {arguments and defaults} {
  215.     proc tproc {x {y y-default} args} {
  216.     return [list $x $y $args]
  217.     }
  218.     list [catch {tproc} msg] $msg
  219. } {1 {no value given for parameter "x" to "tproc"}}
  220.  
  221. test proc-4.1 {variable numbers of arguments} {
  222.     proc tproc args {return $args}
  223.     tproc
  224. } {}
  225. test proc-4.2 {variable numbers of arguments} {
  226.     proc tproc args {return $args}
  227.     tproc 1 2 3 4 5 6 7 8
  228. } {1 2 3 4 5 6 7 8}
  229. test proc-4.3 {variable numbers of arguments} {
  230.     proc tproc args {return $args}
  231.     tproc 1 {2 3} {4 {5 6} {{{7}}}} 8
  232. } {1 {2 3} {4 {5 6} {{{7}}}} 8}
  233. test proc-4.4 {variable numbers of arguments} {
  234.     proc tproc {x y args} {return $args}
  235.     tproc 1 2 3 4 5 6 7
  236. } {3 4 5 6 7}
  237. test proc-4.5 {variable numbers of arguments} {
  238.     proc tproc {x y args} {return $args}
  239.     tproc 1 2
  240. } {}
  241. test proc-4.6 {variable numbers of arguments} {
  242.     proc tproc {x missing args} {return $args}
  243.     list [catch {tproc 1} msg] $msg
  244. } {1 {no value given for parameter "missing" to "tproc"}}
  245.  
  246. test proc-5.1 {error conditions} {
  247.     list [catch {proc} msg] $msg
  248. } {1 {wrong # args: should be "proc name args body"}}
  249. test proc-5.2 {error conditions} {
  250.     list [catch {proc tproc b} msg] $msg
  251. } {1 {wrong # args: should be "proc name args body"}}
  252. test proc-5.3 {error conditions} {
  253.     list [catch {proc tproc b c d e} msg] $msg
  254. } {1 {wrong # args: should be "proc name args body"}}
  255. test proc-5.4 {error conditions} {
  256.     list [catch {proc tproc \{xyz {return foo}} msg] $msg
  257. } {1 {unmatched open brace in list}}
  258. test proc-5.5 {error conditions} {
  259.     list [catch {proc tproc {{} y} {return foo}} msg] $msg
  260. } {1 {procedure "tproc" has argument with no name}}
  261. test proc-5.6 {error conditions} {
  262.     list [catch {proc tproc {{} y} {return foo}} msg] $msg
  263. } {1 {procedure "tproc" has argument with no name}}
  264. test proc-5.7 {error conditions} {
  265.     list [catch {proc tproc {{x 1 2} y} {return foo}} msg] $msg
  266. } {1 {too many fields in argument specifier "x 1 2"}}
  267. test proc-5.8 {error conditions} {
  268.     catch {return}
  269. } 2
  270. test proc-5.9 {error conditions} {
  271.     list [catch {return 1 2} msg] $msg
  272. } {1 {wrong # args: should be "return ?value?"}}
  273. test proc-5.10 {error conditions} {
  274.     list [catch {global} msg] $msg
  275. } {1 {wrong # args: should be "global varName ?varName ...?"}}
  276. proc tproc {} {
  277.     set a 22
  278.     global a
  279. }
  280. test proc-5.11 {error conditions} {
  281.     list [catch {tproc} msg] $msg
  282. } {1 {variable "a" already exists}}
  283. test proc-5.12 {error conditions} {
  284.     catch {rename tproc {}}
  285.     catch {
  286.     proc tproc {x {} z} {return foo}
  287.     }
  288.     list [catch {tproc 1} msg] $msg
  289. } {1 {invalid command name: "tproc"}}
  290. test proc-5.13 {error conditions} {
  291.     proc tproc {} {
  292.     set a 22
  293.     error "error in procedure"
  294.     return
  295.     }
  296.     list [catch tproc msg] $msg
  297. } {1 {error in procedure}}
  298. test proc-5.14 {error conditions} {
  299.     proc tproc {} {
  300.     set a 22
  301.     error "error in procedure"
  302.     return
  303.     }
  304.     catch tproc msg
  305.     set errorInfo
  306. } {error in procedure
  307.     while executing
  308. "error "error in procedure""
  309.     (procedure "tproc" line 3)
  310.     invoked from within
  311. "tproc"}
  312. test proc-5.15 {error conditions} {
  313.     proc tproc {} {
  314.     set a 22
  315.     break
  316.     return
  317.     }
  318.     catch tproc msg
  319.     set errorInfo
  320. } {invoked "break" outside of a loop
  321.     while executing
  322. "tproc"}
  323. test proc-5.16 {error conditions} {
  324.     proc tproc {} {
  325.     set a 22
  326.     continue
  327.     return
  328.     }
  329.     catch tproc msg
  330.     set errorInfo
  331. } {invoked "continue" outside of a loop
  332.     while executing
  333. "tproc"}
  334.